home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir42 / c7105.zip / CPD21.TPX < prev    next >
Text File  |  1994-03-02  |  66KB  |  1,552 lines
  1. #!┌───────────────────────────┤Template Segment├───────────┬─────────────────┐
  2. #!│                               CPD21.TPX                │Version: 3007.105│
  3. #!├───────────────────────────────┤Contents├───────────────┴─────────────────┤
  4. #!│Structure             Type       Description                              │
  5. #!│────────────────────  ─────────  ─────────────────────────────────────────│
  6. #!│Table21               PROCEDURE  Version 2.1-Style Table Procedure        │
  7. #!│Form21                PROCEDURE  Version 2.1-Style Form Procedure         │
  8. #!│MemForm21             PROCEDURE  Version 2.1-Style MemForm Procedure      │
  9. #!│Menu21                PROCEDURE  Version 2.1-Style Menu Procedure         │
  10. #!│BeginRepeat           GROUP                                               │
  11. #!│RepeatErrorCheck      GROUP                                               │
  12. #!│Form21KeyHandling     GROUP                                               │
  13. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  14. #!│Version   Comments                                                        │
  15. #!│────────  ────────────────────────────────────────────────────────────────│
  16. #!│3007.000  Release of CDD3 version 3007 templates                          │
  17. #!│3007.103  Repaired Form21 Procedure                                       │
  18. #!│3007.105  Repaired Form21 Procedure                                       │
  19. #!│          Repaired MemForm21 Procedure                                    │
  20. #!│          Repaired Table21 Procedure                                      │
  21. #!│          Repaired Menu21 Procedure                                       │
  22. #!│          Added Form21Keyhandling GROUP                                   │
  23. #!└──────────────────────────────────────────────────────────────────────────┘
  24. #!
  25. #PROCEDURE(Table21,'Version 2.1-Style Table Procedure'),SCREEN,PULLDOWN
  26. #!
  27. #!┌──────────────────────────┤Procedure Template├──────────┬─────────────────┐
  28. #!│                                Table21                 │Version: 3007.105│
  29. #!├──────────────────────────────┤Description├─────────────┴─────────────────┤
  30. #!│ The Table21 Template generates a Clarion Professional Developer 2.1 type │
  31. #!│ Table procedure.  This procedure uses the REPEAT library procedures      │
  32. #!│ built in to %clapfx%REPEA.LIB, whose source code is in REPEAT.CLA        │
  33. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  34. #!│Version   Comments                                                        │
  35. #!│────────  ────────────────────────────────────────────────────────────────│
  36. #!│3007.000  Release of CDD3 version 3007 templates                          │
  37. #!│3007.105  Completed support for PullDowns                                 │
  38. #!│          Repaired BREAK in main loop, replacing it with DO               │
  39. #!│          ProcedureReturn                                                 │
  40. #!└──────────────────────────────────────────────────────────────────────────┘
  41. #!
  42. #PROMPT('Range &Limit Field',COMPONENT),%KeyRangeField
  43. #PROMPT('Range &Value Field',FIELD),%RangeValue
  44. #PROMPT('Record Filter',@S180),%RecordFilter
  45. #PROMPT('Locator Field',COMPONENT),%Locator
  46. #PROMPT('Incremental Locator',CHECK),%IncrementalLocator
  47. #PROMPT('Upd&ate Procedure',PROCEDURE),%UpdateProc
  48. #PROMPT('Update Call in Embed',CHECK),%EmbeddedUpdate
  49. #PROMPT('Enable Hot Records',CHECK),%HotBar
  50. #INSERT(%StandardHeader)
  51. #MAP('REPEAT.INC')
  52. #PROJECT('%clapfx%REPEA.LIB')
  53. #PROTOTYPE('(<BYTE>)')
  54. %Procedure       PROCEDURE(Mode)
  55. #INSERT(%SetBrowseSymbols)
  56. #INSERT(%RepeatErrorCheck)
  57. #FIX(%ScreenField,'?Exit')
  58. #IF(%ScreenField)
  59.   #SET(%ExitExists,'1')
  60. #ELSE
  61.   #SET(%ExitExists,%Null)
  62. #ENDIF
  63. #SET(%FirstField,%Null)
  64. #FOR(%ScreenField)
  65.   #IF(%ScreenFieldSkip)
  66.     #SET(%FirstField,%ScreenField)
  67.     #BREAK
  68.   #ENDIF
  69. #ENDFOR
  70. #IF(%FirstField = %Null AND %ExitExists = %NULL)
  71.   #SET(%ErrorMessage,'Table21 Must Have Exit Button If All Fields Are SKIP')
  72.   #ERROR(%ErrorMessage)
  73. #ENDIF
  74. #!
  75. #IF(%KeyRangeField)
  76.   #FIX(%Key,%PrimaryKey)
  77.   #SET(%Found, %Null)
  78.   #FOR(%KeyField)
  79.     #IF(%Found <> 'Yes')
  80. SAV::%KeyField  Like(%KeyField)
  81.     #ENDIF
  82.     #IF(UPPER(%KeyField) = UPPER(%KeyRangeField))
  83.      #SET(%Found, 'Yes')
  84.     #ENDIF
  85.   #ENDFOR
  86. #ENDIF
  87. ButtonIsDisabled BYTE                            !Flag to allow button enable
  88. RptInitialized   BYTE(0)
  89. Ndx              BYTE
  90. MaxRows          BYTE
  91. #INSERT(%FileControl)
  92. %LocalData
  93. %ScreenStructure
  94. #IF(%PullDown)
  95. %PulldownStructure
  96. SAV::PullDownOpened BYTE(0)
  97. #ENDIF
  98. #EMBED('Data Section')
  99.  
  100.   CODE
  101.   #EMBED('Setup Procedure')
  102.   #INSERT(%FileControl)
  103.   #FIX(%File,%Primary)
  104.   OPEN(Screen)                                   !Open the screen
  105.   #EMBED('Setup Screen')
  106.   DISPLAY                                        !Display screen fields
  107.   #INSERT(%SaveRangeFields)
  108.   #IF(%Pulldown)                                #!If a pulldown exists
  109.   OPEN(%Pulldown)                               #<!Open the pulldown menu
  110.   SAV::PullDownOpened = True
  111.   #EMBED('Setup Pulldown')                       #! Embedded Source Code
  112.   #ENDIF
  113.   #INSERT(%BeginRepeat)
  114.   RptInitialized = TRUE
  115.   Ndx = 1                                        !Set first point bar position
  116.   #FIX(%ScreenField,'?Select')
  117.   #IF(%ScreenField)
  118.   #SET(%SelectExists,'1')
  119.   IF Mode <> SelectRecord                       #<!Is This Not In Select Mode?
  120.     DISABLE(?Select)                             !  Dim the select button
  121.   END                                            !End IF
  122.   #ELSE
  123.   #SET(%SelectExists,%Null)
  124.   #ENDIF
  125.   LOOP                                           !Process table requests
  126.     ALERT(EscKey)                                !Alert the EscKey
  127.     ALERT(CtrlEsc)                               !Alert the CtrlEsc
  128.     CASE RepeatAction(%Primary,%PrimaryKey,Ndx)#<!Scroll the file
  129.     OF ProcessField                              !Process a field
  130.   #FOR(%Formula)
  131.     #IF(UPPER(%FormulaClass) <> 'POINT')
  132.       #IF(UPPER(%FormulaClass) <> 'FILTER')
  133.       #INSERT(%GenerateFormula)
  134.       #ENDIF
  135.     #ENDIF
  136.   #ENDFOR
  137.       #EMBED('End of General Formulas')
  138.       CASE KEYCODE()                             !User defined hotkey check
  139.   #FOR(%HotKey)
  140.       OF %HotKey                               #<!User defined HotKey
  141.         %HotKeyProc                            #<!HotKey Procedure
  142.   #ENDFOR
  143.       OF EscKey                                  !On EscKey
  144.         IF FIELD() = %FirstField                 #<!If first field
  145.   #IF(%ExitExists = %Null)
  146.           GET(%Primary,0)
  147.           DO ProcedureReturn
  148.   #ELSE
  149.           SELECT(?Exit)
  150.           PRESS(EnterKey)
  151.           CYCLE
  152.   #ENDIF
  153.   #IF(%ExitExists = %Null)
  154.         ELSE
  155.           SELECT(?-1)
  156.           CYCLE
  157.         END
  158.   #ELSE
  159.         ELSIF FIELD() <> ?Exit
  160.           SELECT(?-1)
  161.           CYCLE
  162.         END
  163.   #ENDIF
  164.       OF CtrlEsc                                 !On exit
  165.   #IF(%ExitExists = %Null)
  166.         GET(%Primary,0)
  167.         DO ProcedureReturn
  168.   #ELSE
  169.         IF FIELD() <> ?Exit
  170.           SELECT(?Exit)
  171.           PRESS(EnterKey)
  172.           CYCLE
  173.         END
  174.   #ENDIF
  175.       END                                        !End CASE
  176.       IF SELECTED() <> FIELD()                   ! If a new field is selected
  177.         CASE SELECTED()                          ! Jump to setup routine
  178.         #IF(%KeyRangeField)
  179.         OF ?Point                                ! Save range on point bar
  180.           #INSERT(%SaveRangeFields)
  181.         #ENDIF
  182.         #INSERT(%ScreenSetupRoutines)
  183.         END                                      ! End CASE SELECTED()
  184.       END                                        ! End IF
  185.       CASE FIELD()                               !Jump to edit routine
  186.   #FOR(%ScreenField)
  187.     #IF(%ScreenField = '?Insert')
  188.       #IF((%UpdateProc OR %EmbeddedUpdate))
  189.        OF ?Insert                                !Process the Insert Button
  190.         #IF(%ScreenFieldEdit)
  191.         %ScreenFieldEdit                       #<! Insert button Edit Routine
  192.         #ENDIF
  193.         #INSERT(%ClearFileFields)
  194.         #INSERT(%RestoreRangeFields)
  195.         SETKEYCODE(InsKey)                       ! Set action to insert
  196.         DO UpdateProcedure                       ! Call the update procedure
  197.         SELECT(?Point)                           ! Reselect the point field
  198.       #ENDIF
  199.     #ELSIF(%ScreenField = '?Change')
  200.       #IF((%UpdateProc OR %EmbeddedUpdate))
  201.       OF ?Change                                 !Process the Change Button
  202.         #IF(%ScreenFieldEdit)
  203.         %ScreenFieldEdit                       #<! Change button Edit Routine
  204.         #ENDIF
  205.         SETKEYCODE(EnterKey)                     ! Set action to Change
  206.         DO UpdateProcedure                       ! Call the update procedure
  207.         SELECT(?Point)                           ! Reselect the point field
  208.       #ENDIF
  209.     #ELSIF(%ScreenField = '?Select')
  210.       #IF((%UpdateProc OR %EmbeddedUpdate))
  211.       OF ?Select                                 !Process the Change Button
  212.         #IF(%ScreenFieldEdit)
  213.         %ScreenFieldEdit                       #<! Change button Edit Routine
  214.         #ENDIF
  215.         DO ProcedureReturn
  216.       #ENDIF
  217.     #ELSIF(%ScreenField = '?Delete')
  218.       #IF((%UpdateProc OR %EmbeddedUpdate))
  219.       OF ?Delete                                 !Process the delete button
  220.         #IF(%ScreenFieldEdit)
  221.         %ScreenFieldEdit                       #<! Delete button edit routine
  222.         #ENDIF
  223.         SETKEYCODE(DelKey)                       ! Set action to delete
  224.         DO UpdateProcedure                       ! Call the update procedure
  225.         SELECT(?Point)                           ! Reselect the point field
  226.       #ENDIF
  227.     #ELSIF(%ScreenField = '?Point')
  228.       OF ?Point                                  !Process the list field
  229.       #IF((%UpdateProc OR %EmbeddedUpdate))
  230.         CASE KEYCODE()                           ! Jump to keycode routine
  231.         #IF(%KeyboardInsert)
  232.         OF InsKey                                ! For the insert key
  233.           #INSERT(%ClearFileFields)
  234.           #INSERT(%RestoreRangeFields)
  235.           DO UpdateProcedure                     !  Call the update procedure
  236.         #ENDIF
  237.         #IF(%KeyboardDelete)
  238.         OF DelKey                                ! For the delete key
  239.           DO UpdateProcedure                     !  Call the update procedure
  240.         #ENDIF
  241.         #IF(%KeyboardChange AND %KeyboardSelect)
  242.         OF EnterKey                              ! Or the enter key
  243.         OROF MouseLeft2                          ! Or a double mouse click
  244.           IF Mode = SelectRecord                 !   When selection mode
  245.             DO ProcedureReturn                   !     Return to caller
  246.           ELSE                                   !   Else
  247.             DO UpdateProcedure                   !     Call update procedure
  248.           END                                    !   End IF
  249.         OF CtrlEnter
  250.           DO UpdateProcedure
  251.         #ELSIF(%KeyboardChange)
  252.         OF EnterKey                              ! Or the enter key
  253.         OROF MouseLeft2                          ! Or a double mouse click
  254.           DO UpdateProcedure                     !     Call update procedure
  255.         #ELSIF(%KeyboardSelect)
  256.         OF EnterKey                              ! Or the enter key
  257.         OROF MouseLeft2                          ! Or a double mouse click
  258.           IF Mode = SelectRecord                 !   When selection mode
  259.             DO ProcedureReturn                   !     Return to caller
  260.           END
  261.         #ENDIF
  262.         END                                      ! End CASE
  263.       #ELSE
  264.         IF KEYCODE() = EnterKey  OR |            ! Or the enter key
  265.            KEYCODE() = MouseLeft2                ! Or a double mouse click
  266.           IF Mode = SelectRecord                 !   When selection mode
  267.             DO ProcedureReturn                   !     Return To Caller
  268.           END                                    !   End IF
  269.         END                                      ! End IF
  270.       #ENDIF
  271.     #ELSIF(%ScreenField = '?Exit')
  272.       OF ?Exit                                   !Process the Exit button
  273.       #IF(%ScreenFieldEdit)
  274.         %ScreenFieldEdit                       #<! Exit button Edit Routine
  275.       #ENDIF
  276.         GET(%Primary,0)                          ! Dereference For Select
  277.         DO ProcedureReturn                       ! Return to caller
  278.     #ELSE
  279.       #INSERT(%ScreenEditRoutines)             #<! Completed %ScreenField
  280.     #ENDIF
  281.   #ENDFOR
  282.       #INSERT(%PulldownEditRoutines)
  283.       END                                        !End CASE FIELD()
  284.     OF NoRecords                                 !No records to browse
  285.       #INSERT(%ClearFileFields)
  286.       #INSERT(%RestoreRangeFields)
  287.       DISPLAY                                    !Redisplay the screen
  288.   #IF(%ChangeExists)
  289.       DISABLE(?Change)                           ! Disable the change button
  290.   #ENDIF
  291.   #IF(%DeleteExists)
  292.       DISABLE(?Delete)                           ! Disable the delete button
  293.   #ENDIF
  294.       ButtonIsDisabled = TRUE                    ! Set to button is disabled
  295.       IF RECORDS(%Primary)                     #<! If file is not empty
  296.         IF ?Point <> %FirstEntryField          #<!  And point is not first
  297.           SELECT(%FirstEntryField)             #<!   Select the first field
  298.         ELSE                                     !  Else
  299.   #IF((%UpdateProc OR %EmbeddedUpdate))
  300.     #IF(%InsertExists)
  301.           SELECT(?Insert)                        !   Select the Insert Button
  302.     #ELSE
  303.           #INSERT(%RestoreRangeFields)
  304.           SETKEYCODE(InsKey)                     !   Ask for a new record
  305.           DO UpdateProcedure                     !   Call the update procedure
  306.           IF POSITION(%PrimaryKey) = ''        #<!   If record not added
  307.             DO ProcedureReturn                   !    Return to caller
  308.           ELSE                                   !   Else record was added
  309.       #IF(%ChangeExists)
  310.             ENABLE(?Change)                      !     Enable change button
  311.       #ENDIF
  312.       #IF(%DeleteExists)
  313.             ENABLE(?Delete)                      !     Enable delete button
  314.       #ENDIF
  315.             ButtonIsDisabled = FALSE             !     Set to button enabled
  316.           END                                    !   End IF
  317.     #ENDIF
  318.   #ELSE
  319.           DO ProcedureReturn                     !   Return to caller
  320.   #ENDIF
  321.         END                                      !  End IF
  322.       ELSE                                       ! Else if file is empty
  323.   #IF((%UpdateProc OR %EmbeddedUpdate))
  324.         #INSERT(%RestoreRangeFields)
  325.         SETKEYCODE(InsKey)                       !  Ask for a new record
  326.         DO UpdateProcedure                       !  Call the update procedure
  327.           IF POSITION(%PrimaryKey) = ''        #<!   If record not added
  328.             DO ProcedureReturn                   !    Return to caller
  329.           ELSE                                   !   Else record was added
  330.     #IF(%ChangeExists)
  331.             ENABLE(?Change)                      !     Enable change button
  332.     #ENDIF
  333.     #IF(%DeleteExists)
  334.             ENABLE(?Delete)                      !     Enable delete button
  335.     #ENDIF
  336.             ButtonIsDisabled = FALSE             !     Set to button enabled
  337.           END                                    !   End IF
  338.   #ELSE
  339.         DO ProcedureReturn                       !  Return to caller
  340.   #ENDIF
  341.       END                                        ! End IF
  342.     OF FilterRecord                              !Should we add this record
  343.       IF ButtonIsDisabled                        !  If button is disabled
  344.     #IF(%ChangeExists)
  345.         ENABLE(?Change)                          !     Enable change button
  346.     #ENDIF
  347.     #IF(%DeleteExists)
  348.         ENABLE(?Delete)                          !     Enable delete button
  349.     #ENDIF
  350.         ButtonIsDisabled = FALSE                 !     Set to button enabled
  351.       END                                        !  End IF
  352.     #IF(%KeyRangeField)                         #!If using range limits
  353.       #IF(%RangeValue)                          #! If using range value field
  354.         #IF(%KeyNoCase)                         #!  Key is not case sensitive
  355.       IF (UPPER(%KeyRangeField) <> UPPER(%RangeValue)) #<! If range field has changed
  356.         #ELSE
  357.       IF (%KeyRangeField <> %RangeValue)       #<! If range field has changed
  358.         #ENDIF
  359.         PREVIOUS(%Primary)                     #<!  Signal browse to build
  360.         #INSERT(%ClearFileFields)               #!  Clear for screen fields
  361.         #INSERT(%RestoreRangeFields)
  362.         CYCLE                                    !  Cycle for BrowseAction
  363.       END                                        ! End IF
  364.       #ELSE
  365.         #SET(%Found, %Null)
  366.         #FOR(%KeyField)
  367.           #IF(%Found <> 'Yes')
  368.         #IF(%KeyNoCase)                         #! Key is not case sensitive
  369.       IF (UPPER(%KeyField) <> UPPER(SAV::%KeyField)) #<! If range field has changed
  370.         #ELSE
  371.       IF (%KeyField <> SAV::%KeyField)         #<! If range field has changed
  372.         #ENDIF
  373.         PREVIOUS(%Primary)                     #<!  Signal browse to build
  374.         #INSERT(%ClearFileFields)               #!  Clear for screen fields
  375.         #INSERT(%RestoreRangeFields)
  376.         CYCLE                                    !  Cycle for BrowseAction
  377.       END                                        ! End IF
  378.           #ENDIF
  379.           #IF(UPPER(%KeyField) = UPPER(%KeyRangeField))
  380.             #SET(%Found, 'Yes')
  381.           #ENDIF
  382.         #ENDFOR
  383.       #ENDIF
  384.     #ENDIF
  385.     #IF(%RecordFilter)
  386.       IF ~(%RecordFilter)                      #<!If Filter condition not met
  387.         GET(%Primary,0)                        #<! Dereference the record
  388.         CYCLE                                    ! Return to Top of LOOP
  389.       END                                        !End IF
  390.     #ELSE
  391.       #FOR(%Formula)
  392.         #IF(UPPER(%FormulaClass) = 'FILTER')
  393.           #IF(%FormulaType <> 'COMPUTED')
  394.       IF ~(%FormulaCondition)                  #<!If Filter condition not met
  395.         GET(%Primary,0)                        #<! Dereference the record
  396.         CYCLE                                    ! Return to Top of LOOP
  397.       END                                        !End IF
  398.           #ELSE
  399.       IF ~(%FormulaComputation)                #<!If filter condition not met
  400.         GET(%Primary,0)                        #<! Dereference the record
  401.         CYCLE                                    ! Return to top of LOOP
  402.       END                                        !End IF
  403.           #ENDIF
  404.         #ENDIF
  405.       #ENDFOR
  406.     #ENDIF
  407.       #EMBED('After Filter and Range Check')
  408.       #INSERT(%GetSecondaryRecords)
  409.   #FOR(%Formula)
  410.     #IF(UPPER(%FormulaClass) = 'POINT')
  411.       #INSERT(%GenerateFormula)
  412.     #ENDIF
  413.   #ENDFOR
  414.       #EMBED('POINT Class formula')
  415.     OF ResetFirst                                !Set to first in a range
  416.       #IF(%KeyRangeField)
  417.       #INSERT(%ClearRecordLow)
  418.       #INSERT(%RestoreRangeFields)
  419.       SET(%PrimaryKey,%PrimaryKey)             #<! SET to the closest match
  420.       #ENDIF
  421.       #EMBED('Set to First Record')
  422.     OF ResetLast                                 !Set to last in a range
  423.       #IF(%KeyRangeField)
  424.       #INSERT(%ClearRecordHigh)
  425.       CLEAR(Pointer#,1)                          !
  426.       #INSERT(%RestoreRangeFields)
  427.       SET(%PrimaryKey,%PrimaryKey,Pointer#)    #<! SET to the closest match
  428.       #ENDIF
  429.       #EMBED('Set to Last Record')
  430.   #IF(%HotBar)
  431.     OF ProcessSelected                           !Process highlighted record
  432.       #INSERT(%GetSecondaryRecords)
  433.     #FOR(%Formula)
  434.       #IF(UPPER(%FormulaClass) <> 'FILTER')
  435.       #INSERT(%GenerateFormula)
  436.       #ENDIF
  437.     #ENDFOR
  438.       #EMBED('Process Selected Record')
  439.       DISPLAY()                                #<!  Display the hot fields
  440.   #ENDIF
  441.   #IF(%Locator)
  442.  
  443.     OF ClearRestOfKey                            !Clear subfields of a locator
  444.     #SET(%ClearSW,'0')
  445.     #FOR(%KeyField)
  446.       #IF(%ClearSW = '1')
  447.      CLEAR(%KeyField)
  448.       #ENDIF
  449.       #IF(%KeyField = %Locator)
  450.         #SET(%ClearSW,'1')
  451.       #ENDIF
  452.     #ENDFOR
  453.   #ENDIF
  454.     END                                          ! End CASE
  455.   END                                            !End LOOP
  456.   DO ProcedureReturn
  457.   #IF((%UpdateProc OR %EmbeddedUpdate))
  458.  
  459. UpdateProcedure ROUTINE
  460.   #EMBED('Prior to Update Procedure')
  461.   %UpdateProc                                  #<!Call the update procedure
  462.   #EMBED('After Update Procedure')
  463.   #ENDIF
  464. #!
  465. !─────────────────────────────────────────────────────────────────────────────
  466. ProcedureReturn ROUTINE
  467.   IF RptInitialized
  468.     EndRepeat                                    !End the Repeat session
  469.   END
  470.   #IF(%Pulldown)                                #! If a Pulldown exists
  471.   IF SAV::PullDownOpened                        #<! IF the pulldown opened
  472.     CLOSE(%Pulldown)                            #<! Close the Pulldown
  473.   END                                           #<! END (IF the pulldown...)
  474.   #ENDIF                                        #! END (IF a PullDown...)
  475.   #INSERT(%FileControl)
  476.   DO EndOfProcedureEmbed
  477.   RETURN
  478.  
  479. !─────────────────────────────────────────────────────────────────────────────
  480. EndOfProcedureEmbed ROUTINE
  481. #EMBED('End of Procedure')
  482. #EMBED('Custom Routines')
  483.  
  484. #PROCEDURE(Form21,'Version 2.1-Style Form Procedure'),SCREEN,PULLDOWN
  485. #!
  486. #!┌──────────────────────────┤Procedure Template├──────────┬─────────────────┐
  487. #!│                                Form21                  │Version: 3007.105│
  488. #!├──────────────────────────────┤Description├─────────────┴─────────────────┤
  489. #!│ The Form21 Template generates a Clarion Professional Developer 2.1 type  │
  490. #!│ Form procedure.                                                          │
  491. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  492. #!│Version   Comments                                                        │
  493. #!│────────  ────────────────────────────────────────────────────────────────│
  494. #!│3007.000  Release of CDD3 version 3007 templates                          │
  495. #!│3007.103  Added RI Initialization Code                                    │
  496. #!│          Added RI Initialization Code                                    │
  497. #!│3007.105  Completed support for PullDowns                                 │
  498. #!│          Removed duplicate AbortTransaction declaration                  │
  499. #!│          Repaired Escape Key Handling (Extra END)                        │
  500. #!│          Increased size of Message Prompts to @S30.                      │
  501. #!│          Moved call to ShowWarning in I/O code to WARNINGS.TPX           │
  502. #!│          Removed a BREAK in main processing loop and replaced it with    │
  503. #!│          DO ProcedureReturn                                              │
  504. #!│          Moved call to FREE(RecordQueue) to ProcedureReturn ROUTINE      │
  505. #!│          Moved CASE KEYCODE() handing to Form21KeyHandling GROUP         │
  506. #!└──────────────────────────────────────────────────────────────────────────┘
  507. #!
  508. #PROTOTYPE('')
  509. #PROMPT('Insert message',@S30),%InsertMsg
  510. #PROMPT('Chan&ge message',@S30),%ChangeMsg
  511. #PROMPT('De&lete message',@S30),%DeleteMsg
  512. #PROMPT('Action after ADD',OPTION),%AddAction
  513. #PROMPT('Return to caller ',RADIO)
  514. #PROMPT('Retain Record    ',RADIO)
  515. #PROMPT('Clear Record     ',RADIO)
  516. #PROMPT('Copy field hot&key:',KEYCODE),%CopyKey
  517. #PROMPT('Next Procedure ',PROCEDURE),%NextProcedure
  518. #INSERT(%StandardHeader)
  519. #INSERT(%InitFormSymbols)
  520. #IF(%Primary = %NULL)
  521.   #SET(%ErrorMessage,(' WARNING during Code Generation in Procedure: '& %Procedure ))
  522.   #ERROR(%ErrorMessage)
  523.   #SET(%ErrorMessage,( ' No File Defined In File Schematic For FORM Template '))
  524.   #ERROR(%ErrorMessage)
  525. #ENDIF
  526. %Procedure      PROCEDURE
  527.  
  528. %LocalData
  529.  
  530. SelectedField    SHORT                           !Process selected Field
  531. #INSERT(%FileControl)                            #!Primary or Secondary Opened
  532. NoMoreFields     BYTE(0)                         !No more fields flag
  533. #IF(UPPER(CLIP(%AddAction)) = 'RETAIN RECORD')
  534.  #IF(%CopyKey)
  535. SCREEN    %ScreenAttributes,ALRT(%CopyKey)
  536. %ScreenPaintDeclarations
  537. %ScreenStringDeclarations
  538. %ScreenFieldDeclarations
  539.           .
  540.   #IF(NOT %SharedFiles)
  541. SAV:SaveRecord LIKE(%FilePre:Record),PRE(SAV)
  542.   #ENDIF
  543.  #ELSE
  544. %ScreenStructure
  545.   #IF(NOT %SharedFiles)
  546. SAV:SaveRecord LIKE(%FilePre:Record),PRE(SAV)
  547.   #ENDIF
  548.  #ENDIF
  549. #ELSE
  550. %ScreenStructure
  551. #ENDIF
  552. #IF(%PullDown)
  553. %PulldownStructure
  554. SAV::PullDownOpened BYTE(0)
  555. #ENDIF
  556. #IF(%SharedFiles)
  557. RecordQueue   QUEUE,PRE(SAV)                     !Queue for concurrency checking
  558. SaveRecord    LIKE(%FilePre:Record),PRE(SAV)     #<!size of primary file record
  559. #FOR(%FileMemo)
  560. #FIX(%Field,%FileMemo)
  561. SAV:%FieldID STRING(SIZE(%FileMemo))
  562. #ENDFOR
  563.               .                                  #<!End Queue structure
  564. #ENDIF
  565. AbortTransaction BYTE
  566. #IF(%RelatedChildList)
  567.   #SET(%ProcessingFile,%Primary)
  568. #INSERT(%RelationalAccessFlds)                   #<!Declare link fields
  569. RI:RestrictUpdate byte
  570. RI:RestrictDelete byte
  571.   #IF(%PrimaryDriver = 'Paradox3')
  572.     #FIX(%File,%Primary)
  573. UpdRelation   STRING(SIZE(%FilePre:Record))      #<!Position of last related record
  574.   #ELSE
  575. UpdRelation   STRING(10)                         #<!Position of last related record
  576.   #ENDIF
  577.   #IF(%PrimaryDriver='Btrieve')
  578. SAV:Position  string(255)
  579.   #ENDIF
  580. #ENDIF
  581. #IF(%PrimaryDriver = 'Paradox3')
  582. #FIX(%File,%Primary)
  583. SavePointer   STRING(SIZE(%FilePre:Record))      !Position of current record
  584. AutoAddPtr    STRING(SIZE(%FilePre:Record))      !Position of Autoinc record
  585. #ELSE
  586. SavePointer   STRING(10)                         !Position of current record
  587. AutoAddPtr    STRING(10)                         !Position of Autoinc record
  588. #ENDIF
  589. AutoIncAdd    BYTE(0)                            !On for Autoincrement add
  590. #IF(UPPER(CLIP(%AddAction)) <> 'RETURN TO CALLER')
  591. LastPosition  STRING(10)                         !Position of last ADD
  592. #ENDIF
  593. #IF(UPPER(CLIP(%AddAction)) = 'RETAIN RECORD')
  594.  #IF(%CopyKey)
  595. #INSERT(%FieldDups)
  596.  #ENDIF
  597. #ENDIF
  598. #IF(%PrimeKeysExist)
  599. #INSERT(%SavePrimedFields)
  600. #ENDIF
  601. #EMBED('Data Section')
  602.  
  603.   CODE
  604.  
  605.   #EMBED('Setup Procedure')
  606.   #INSERT(%FileControl)                          #<!Ensure Primary file is OPEN
  607.   #SET(%OkExists,%Null)
  608.   #SET(%CancelExists,%Null)
  609.   #FIX(%ScreenField,'?Ok')
  610.   #IF(%ScreenField)
  611.     #SET(%OkExists,'TRUE')
  612.   #ENDIF
  613.   #FIX(%ScreenField,'?Cancel')
  614.   #IF(%ScreenField)
  615.     #SET(%CancelExists,'TRUE')
  616.   #ENDIF
  617.   #SET(%FirstField,%Null)
  618.   #FOR(%ScreenField)
  619.     #IF(NOT %ScreenFieldSkip AND %FirstField= %Null)
  620.       #SET(%FirstField,%ScreenField)
  621.     #ENDIF
  622.     #IF(NOT %ScreenFieldSkip)
  623.       #SET(%LastField,%ScreenField)
  624.     #ENDIF
  625.   #ENDFOR
  626.   #IF(%FirstField = %Null AND %CancelExists = %NULL)
  627.     #SET(%ErrorMessage,'Form21 Must Have Cancel Button If All Fields Are SKIP')
  628.     #ERROR(%ErrorMessage)
  629.   #ENDIF
  630.   #SET(%TableForm,'TRUE')
  631.   CASE KEYCODE()                                 !What Key was pressed?
  632.     OF InsKey                                    !Insert a new record
  633.  
  634.       Action = AddRecord                         !Set action code 1 (ADD)
  635.       #INSERT(%InsertMessage)                    #<!Message for ADD RECORD
  636.   #IF(%AutoInc)
  637.       DO AutoNumber                              !Set autonumber key field(s)
  638.   #ELSE
  639.     #INSERT(%ClearValues)
  640.   #ENDIF
  641.       #EMBED('On Add After Record Buffer Is Cleared')
  642.   #IF(%InitRoutine)                              #<!Field(s) initial value
  643.       DO InitializeFields                        !Initial values from dictionary
  644.   #ENDIF
  645.  
  646.     OF EnterKey                                  !Process a CHANGE request
  647.     OROF MouseLeft2                              !on EnterKey or double mouse
  648.  
  649.       Action = ChangeRecord                      !Set action code 2 (CHANGE)
  650.       #INSERT(%ChangeMessage)                    #<!Message for CHANGE RECORD
  651.   #IF(%SharedFiles)
  652.       #INSERT(%SetupConcurrency)                 #<!Setup multi-user Concurrency
  653.   #ENDIF
  654.   #IF(%CascadeUpdate OR %ClearOnUpdate OR %RestrictUpdate)
  655.       DO RelationAccessSave                      !Save LINKS for relational update
  656.     #SET(%RelUpdateRoutine,'TRUE')
  657.   #ENDIF
  658.  
  659.     OF DelKey                                    !Process a DELETE request
  660.  
  661.       Action = DeleteRecord                      !Set action code 3 (DELETE)
  662.       #INSERT(%DeleteMessage)                    #<!Message for DELETE RECORD
  663.       SavePointer = POSITION(%Primary)           #<!Position in PRIMARY file
  664.   #IF(%CascadeDelete OR %ClearOnDelete OR %RestrictDelete)
  665.       DO RelationAccessSave                      !Save LINKS for relational update
  666.     #SET(%RelDeleteRoutine,'TRUE')
  667.   #ENDIF
  668.  
  669.   END                                            !End CASE Keycode
  670.  
  671.   #FOR(%Formula)
  672.     #IF(UPPER(%FormulaClass) = 'SETUP')
  673.   #INSERT(%GenerateFormula)
  674.     #ENDIF
  675.   #ENDFOR
  676.   #IF(%SecondaryExist)                           #<!IF schema has a Secondary
  677.   DO SecondaryLookups                            !Read any lookup fields
  678.   #ENDIF
  679.   #IF(%PullDownStructure)
  680.   OPEN(%PullDown)
  681.   SAV::PullDownOpened = True
  682.   #EMBED('Setup Pulldown')                       #! Embedded Source Code
  683.   #ENDIF
  684.   OPEN(Screen)                                   !Open the FORM screen
  685.   IF Action = DeleteRecord                       !IF request for DELETE
  686.     DISABLE(1,FIELDS())                          !Disable all screen fields
  687.   #IF(%OkExists)
  688.     ENABLE(?OK)                                  !Enable the OK and the
  689.   #ENDIF
  690.   #IF(%CancelExists)
  691.     ENABLE(?Cancel)                              !Cancel buttons
  692.   #ENDIF
  693.   END                                            !End IF request for delete
  694.   #EMBED('Setup Screen')
  695.   DISPLAY                                        !Display screen fields
  696.  
  697.   LOOP                                           !Begin Main process loop
  698.  
  699.   #IF(%SecondaryExist)                           #<!IF File schema has Secondary
  700.     #INSERT(%SecondaryChanged)
  701.   #ENDIF
  702.   #IF(%LoopFormulasExist)                        #<!Are there Formula fields?
  703.     #SET(%GenerateFormulasOn,'TRUE')
  704.     DO FormulaFields                             !Calculate Formula fields
  705.   #ENDIF
  706.     #EMBED('Computed Fields')
  707.     DISPLAY
  708.     SelectedField = SELECTED()
  709.     IF FIELD() = %LastField AND SelectedField = %LastField |
  710.         AND Action <> DeleteRecord
  711.       SelectedField = NoMoreFields               !Enter On Last Field
  712.   #IF(~%OkExists)
  713.     ELSIF Action = DeleteRecord
  714.       Abort# = False
  715.       LOOP
  716.         ASK
  717.         CASE KEYCODE()
  718.         OF EnterKey
  719.         OROF CtrlEnter
  720.           SelectedField = NoMoreFields             !Accepted Delete
  721.           BREAK
  722.         OF EscKey
  723.         OROF CtrlEsc
  724.           Abort# = True
  725.           BREAK
  726.         ELSE
  727.           CYCLE
  728.         END
  729.       END
  730.       IF Abort#
  731.         DO ProcedureReturn
  732.       END
  733.   #ENDIF
  734.     END
  735.     CASE SelectedField                           !Process selected Field
  736.     #INSERT(%ScreenSetupRoutines)
  737.       OF NoMoreFields                            !User pressed Enter or OK
  738.         CASE Action                              !Process requested Action
  739.           OF AddRecord                           !Action = 1 (ADD)
  740.             ADD(%Primary)                        #<!Add Record to Primary file
  741.           OF ChangeRecord                        !Action = 2 (Change)
  742.   #IF(%SharedFiles)                              #!If making a network app
  743.     #IF(%AutoInc)
  744.             IF AutoIncAdd                        #<!Was this an Autonumber?
  745.       #IF(UPPER(CLIP(%AddAction)) <> 'RETURN TO CALLER')
  746.               LastPosition = POSITION(%Primary)  #<!Save last record position
  747.       #ENDIF
  748.               PUT(%Primary)                      #<!Write the Record
  749.             ELSE                                 #<!not AutoincAdd
  750.     #ENDIF
  751.               DO ConcurrentWrite                 !Concurrent update ROUTINE
  752.               IF AbortTransaction                !AbortWrite is on
  753.     #IF(%CancelExists)
  754.                 SELECT(?Cancel)                  !Place cursor on cancel
  755.                 CYCLE                            !Restart Loop
  756.     #ELSE
  757.                 PRESS(EscKey)
  758.                 SELECT(%FirstField)
  759.                 CYCLE                             !Restart Loop
  760.     #ENDIF
  761.               END
  762.   #ELSE
  763.     #IF(UPPER(CLIP(%AddAction)) <> 'RETURN TO CALLER')
  764.               LastPosition = POSITION(%Primary)  #<!Save last record position
  765.     #ENDIF
  766.   #ENDIF
  767.   #IF(%UpdateChildList)
  768.               DO ConstrainedUpdate               #<!Write the Record
  769.               IF AbortTransaction
  770.     #IF(%CancelExists)
  771.                 SELECT(?Cancel)                  !Place cursor on cancel
  772.                 CYCLE                            !Restart Loop
  773.     #ELSE
  774.                 PRESS(EscKey)
  775.                 SELECT(%FirstField)
  776.                 CYCLE                             !Restart Loop
  777.     #ENDIF
  778.               END
  779.   #ELSE
  780.               PUT(%Primary)
  781.   #ENDIF
  782.   #IF((%SharedFiles AND %AutoInc))
  783.             END                                  #<!IF AutoIncAdd
  784.   #ENDIF
  785.           OF DeleteRecord                        !Action = 3 (Delete)
  786.   #IF(%SharedFiles)
  787.             DO ConcurrentDelete
  788.             IF AbortTransaction
  789.     #IF(%CancelExists)
  790.               SELECT(?Cancel)                    !Place cursor on cancel
  791.               CYCLE                              !Restart Loop
  792.     #ELSE
  793.               PRESS(EscKey)
  794.               SELECT(%FirstField)
  795.               CYCLE                               !Restart Loop
  796.     #ENDIF
  797.             END
  798.   #ENDIF
  799.   #IF(%DeleteChildList)
  800.             DO ConstrainedDelete                 #<!Write the Record
  801.             IF AbortTransaction
  802.     #IF(%CancelExists)
  803.               SELECT(?Cancel)                    !Place cursor on cancel
  804.               CYCLE                              !Restart Loop
  805.     #ELSE
  806.               PRESS(EscKey)
  807.               SELECT(%FirstField)
  808.               CYCLE                               !Restart Loop
  809.     #ENDIF
  810.             END
  811.   #ELSE
  812.             DELETE(%Primary)
  813.   #ENDIF
  814.           END                                    !End CASE Action
  815.  
  816.       IF ERRORCODE()                             !Error check on File I/O
  817.     #IF(%DupKeyCheck)
  818.         #INSERT(%DupKeyCode)
  819.     #ENDIF
  820.         #INSERT(%UpdateErrorMsg)
  821.     #IF(%SharedFiles)
  822.         RELEASE(%Primary)                        #<!Release the held record
  823.     #ENDIF
  824.     #IF(%CancelExists)
  825.         DISABLE(1,FIELDS())                      !Disable all the fields
  826.         ENABLE(?Cancel)                          !Enable Cancel button
  827.         SELECT(?Cancel)                          !and place cursor on Cancel
  828.         DISPLAY                                  !Re-display the screen
  829.         CYCLE                                    !Re-start main LOOP
  830.     #ELSE
  831.          PRESS(EscKey)
  832.          SELECT(%FirstField)
  833.          CYCLE                              !Restart Loop
  834.     #ENDIF
  835.       ELSE                                       !Else no errorcode()
  836.     #IF(%SharedFiles)
  837.         FREE(RecordQueue)                        !Free memory from Queue
  838.     #ENDIF
  839.         #EMBED('Setup Next Procedure')
  840.         %NextProcedure                           #<!Call the Next Procedure
  841.         #EMBED('Return from Next Procedure')
  842.     #IF(UPPER(CLIP(%AddAction)) <> 'RETURN TO CALLER')
  843.         IF Action = AddRecord                    #<!If Action is AddRecord
  844.           LastPosition = POSITION(%Primary)      #<!Save position of last ADD
  845.         END                                      #<!End IF Action = AddRecord
  846.     #ENDIF
  847.     #IF(UPPER(CLIP(%AddAction)) = 'CLEAR RECORD')
  848.         IF (Action = AddRecord) OR (Action = ChangeRecord AND AutoIncAdd)
  849.           ERASE                                  #<!Erase screen fields
  850.           #INSERT(%InsertMessage)                #<!Message for ADD RECORD
  851.           DISPLAY                                !Update screen display
  852.         #FIX(%File,%Primary)
  853.           CLEAR(%FilePre:Record)                 #<!Clear the record buffer
  854.       #IF(%AutoInc)
  855.           DO AutoNumber                          !Increment autonumber key
  856.         #IF(%InitRoutine)
  857.           DO InitializeFields                    !Initial value from DataDictionary
  858.         #ENDIF
  859.           DISPLAY                                !Display screen field
  860.       #ENDIF
  861.           SELECT(1)                              !Place cursor on 1st field
  862.           #EMBED('After ADD on Retain and Clear record')
  863.           CYCLE                                  !Re-start main LOOP
  864.         END                                      !End IF (Action = ....)
  865.     #ELSIF(UPPER(CLIP(%AddAction)) = 'RETAIN RECORD')
  866.         IF (Action = AddRecord) OR (Action = ChangeRecord AND AutoIncAdd)
  867.       #IF(%CopyKey)
  868.           DO SaveScrFlds                         #<!Save the Screen fields
  869.           ERASE
  870.           #INSERT(%InsertMessage)                #<!Message for ADD RECORD
  871.           DISPLAY                                !Update screen display
  872.         #FIX(%File,%Primary)
  873.           CLEAR(%FilePre:Record)                 #<!Clear the record buffer
  874.       #ELSE
  875.         #IF(%AutoInc)
  876.           SAV:SaveRecord = %FilePre:Record       #<!Save the record buffer
  877.         #ENDIF
  878.       #ENDIF
  879.       #IF(%AutoInc)
  880.           DO AutoNumber                          !Increment autonumber key
  881.           %FilePre:Record = SAV:SaveRecord       #<!Restore saved record
  882.           #INSERT(%RestoreAuto)                  #<!Restore AutoNumber(s)
  883.           DISPLAY                                !Display screen fields
  884.       #ENDIF
  885.           SELECT(1)                              !Place cursor on 1st field
  886.           #EMBED('After ADD on Retain and Clear record')
  887.           CYCLE                                  !Re-start main LOOP
  888.         END                                      !End IF (Action = ....)
  889.     #ENDIF                                       #!End %AddAction code
  890.         DO ProcedureReturn                       !Break from main Loop
  891.       END                                        !End IF Errorcode()
  892.  
  893.     END                                          !End CASE Selected()
  894.     ALERT(EscKey)
  895.     #IF(%CancelExists = %Null)
  896.     ALERT(CtrlEsc)
  897.     #ENDIF
  898.     #IF(%OKExists = %Null)
  899.     ALERT(CtrlEnter)
  900.     #ENDIF
  901.     ACCEPT                                       !Enable screen entry
  902.     #IF(UPPER(CLIP(%AddAction)) = 'RETAIN RECORD')
  903.       #IF(%CopyKey)
  904.     #INSERT(%DupFldCall)
  905.       #ENDIF
  906.     #ENDIF
  907.     #INSERT(%Form21KeyHandling)
  908.     #IF(%CancelExists = %Null)
  909.     IF KEYCODE() = CtrlEsc OR (KEYCODE() = EscKey AND FIELD() = %FirstField)
  910.       #IF(%AutoInc)
  911.       IF AutoIncAdd                              !ADDed autoincrement record?
  912.         RESET(%Primary,AutoAddPtr)               #<!Re-position record pointer
  913.         NEXT(%Primary)                           #<!Re-read the record we added
  914.         IF DiskError('Could not READ Record')    !Check for file I/O error
  915.           DO ProcedureReturn                     !Return to caller
  916.         END                                      !End IF Diskerror
  917.         DELETE(%Primary)                         #<!DELETE the record
  918.         IF DiskError('Record could not be Deleted')
  919.           DO ProcedureReturn                     !Return to caller
  920.         END                                      !End IF Diskerror
  921.       END                                        !End IF AutoIncAdd
  922.       #ENDIF
  923.       #IF(UPPER(CLIP(%AddAction)) <> 'RETURN TO CALLER')
  924.       IF LastPosition                            #<!IF a record was added
  925.         RESET(%Primary,LastPosition)             #<!Position to the record
  926.         NEXT(%Primary)                           #<!and read it
  927.       ELSE                                       #<!Else no LastPosition
  928.         GET(%Primary,0)                          #<!signal Browse to re-read
  929.       END                                        #<!END If LastPosition
  930.       #ELSE
  931.       GET(%Primary,0)                            #<!signal Browse to re-read
  932.       #ENDIF
  933.       DO ProcedureReturn                         #<! Return to caller
  934.     END
  935.     #ENDIF
  936.  
  937.     CASE FIELD()                                 !Process fields
  938.     #FOR(%ScreenField)
  939.       #IF(%ScreenFieldUse = '?Ok')
  940.     OF ?Ok                                       !On the OK button
  941.       #EMBED('OK Button Press')
  942.         #IF(%ScreenFieldEdit)
  943.       %ScreenFieldEdit                           #<!Field Edit procedure
  944.         #ENDIF
  945.       SELECT(1)                                  !Start with the first field
  946.       SELECT                                     !and cycle non-stop
  947.       CYCLE                                      !restart main process loop
  948.  
  949.       #ELSIF(%ScreenFieldUse = '?Cancel')
  950.     OF ?Cancel                                   #<! On Cancel button
  951.         #IF(%AutoInc)
  952.       IF AutoIncAdd                              #<! ADDed autoincrement record?
  953.         RESET(%Primary,AutoAddPtr)               #<! Re-position record pointer
  954.         NEXT(%Primary)                           #<! Re-read the record we added
  955.         IF DiskError('Could not READ Record')    #<! Check for file I/O error
  956.           DO ProcedureReturn                     #<! Return to caller
  957.         END                                      #! END (Check for file I/O...)
  958.         DELETE(%Primary)                         #<! DELETE the record
  959.         IF DiskError('Record could not be Deleted')#<! IF cannot delete
  960.           DO ProcedureReturn                     #<! Return to caller
  961.         END                                      #<! End IF Diskerror
  962.       END                                        #<! End IF AutoIncAdd
  963.         #ENDIF
  964.         #IF(%ScreenFieldEdit)
  965.         %ScreenFieldEdit                         #<!Field edit procedure
  966.         #ENDIF
  967.         #IF(UPPER(CLIP(%AddAction)) <> 'RETURN TO CALLER')
  968.         IF LastPosition                          #<!IF a record was added
  969.           RESET(%Primary,LastPosition)           #<!Position to the record
  970.           NEXT(%Primary)                         #<!and read it
  971.         ELSE                                     #<!Else no LastPosition
  972.           GET(%Primary,0)                        #<!signal Browse to re-read
  973.         END                                      #<!END If LastPosition
  974.         #ELSE
  975.         GET(%Primary,0)                          #<!signal Browse to re-read
  976.         #ENDIF
  977.         DO ProcedureReturn                       #<! Return to caller
  978.       #ELSIF(%ScreenField = %LastField)
  979.     OF %LastField
  980.         #IF(%ScreenFieldEdit)
  981.         %ScreenFieldEdit                         #<!Field edit procedure
  982.         #ENDIF
  983.       CYCLE                                      !restart main process loop
  984.       #ELSE
  985.       #INSERT(%ScreenEditRoutines)             #<! Completed %ScreenField
  986.       #ENDIF
  987.     #ENDFOR
  988.     #INSERT(%PulldownEditRoutines)
  989.     END                                          !End CASE FIELD
  990.   END                                            !END MAIN PROCESS LOOP
  991.   DO ProcedureReturn
  992.  
  993. !─────────────────────────────────────────────────────────────────────────────
  994. ProcedureReturn ROUTINE
  995.   #IF(%SharedFiles)
  996.     FREE(RecordQueue)                              !Free the memory Queue
  997.   #ENDIF
  998.   #FOR(%Formula)
  999.     #IF(UPPER(%FormulaClass) = 'RETURN')
  1000.   #INSERT(%GenerateFormula)                      #<!Return Class formula
  1001.     #ENDIF
  1002.   #ENDFOR
  1003.   #IF(%Pulldown)                                #! If a Pulldown exists
  1004.   IF SAV::PullDownOpened                        #<! IF the pulldown opened
  1005.     CLOSE(%Pulldown)                            #<! Close the Pulldown
  1006.   END                                           #<! END (IF the pulldown...)
  1007.   #ENDIF                                        #! END (IF a PullDown...)
  1008.   #INSERT(%FileControl)
  1009.   DO EndOfProcedureEmbed
  1010.   RETURN
  1011.  
  1012. !─────────────────────────────────────────────────────────────────────────────
  1013. EndOfProcedureEmbed ROUTINE
  1014. #EMBED('End of Procedure')
  1015. #EMBED('Custom Routines')
  1016.  
  1017. #INSERT(%AutoIncCode)
  1018. #INSERT(%ConcurrentWrite)
  1019. #INSERT(%ConcurrentDelete)
  1020. #INSERT(%RIUpdates)
  1021. #INSERT(%RIDeletes)
  1022. #INSERT(%InitQue)
  1023. #INSERT(%InitFields)
  1024. #INSERT(%GenFormulas)
  1025. #IF(%SecondaryExist)
  1026. #INSERT(%SecondaryLookups)
  1027. #ENDIF
  1028. #IF(UPPER(CLIP(%AddAction)) = 'RETAIN RECORD')
  1029.  #IF(%CopyKey)
  1030. #INSERT(%SaveScrFlds)
  1031. #INSERT(%DupField)
  1032.  #ENDIF
  1033. #ENDIF
  1034. #!
  1035. #!***************************************************************************
  1036. #PROCEDURE(MemForm21,'Version 2.1-Style MemForm Procedure'),SCREEN,PULLDOWN
  1037. #!
  1038. #!┌──────────────────────────┤Procedure Template├──────────┬─────────────────┐
  1039. #!│                                MemForm21               │Version: 3007.105│
  1040. #!├──────────────────────────────┤Description├─────────────┴─────────────────┤
  1041. #!│ The MemForm21 Template generates a Clarion Professional Developer 2.1    │
  1042. #!│ type MEMForm procedure (A FORM without a file associated with it).       │
  1043. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  1044. #!│Version   Comments                                                        │
  1045. #!│────────  ────────────────────────────────────────────────────────────────│
  1046. #!│3007.000  Release of CDD3 version 3007 templates                          │
  1047. #!│3007.105  Completed support for PullDowns                                 │
  1048. #!│          Added conditional generation of GET(%Primary,0), based on the   │
  1049. #!│          existance of %Primary                                           │
  1050. #!│          Changed ESC key handling to be identical with Form21 handling   │
  1051. #!│          Moved CASE KEYCODE() handing to Form21KeyHandling GROUP         │
  1052. #!└──────────────────────────────────────────────────────────────────────────┘
  1053. #!
  1054. #PROTOTYPE('')
  1055. #PROMPT('Next Procedure ',PROCEDURE),%NextProcedure
  1056. #INSERT(%StandardHeader)
  1057. %Procedure      PROCEDURE
  1058.  
  1059. %LocalData
  1060.  
  1061. SelectedField    SHORT
  1062. NoMoreFields     BYTE(0)                         !No more fields flag
  1063. %ScreenStructure
  1064. #IF(%PullDown)
  1065. %PulldownStructure
  1066. SAV::PullDownOpened BYTE(0)
  1067. #ENDIF
  1068. #EMBED('Data Section')
  1069.  
  1070.   CODE
  1071.  
  1072.   #EMBED('Setup Procedure')
  1073.   #SET(%OkExists,%Null)
  1074.   #SET(%CancelExists,%Null)
  1075.   #FIX(%ScreenField,'?Ok')
  1076.   #IF(%ScreenField)
  1077.     #SET(%OkExists,'1')
  1078.   #ENDIF
  1079.   #FIX(%ScreenField,'?Cancel')
  1080.   #IF(%ScreenField)
  1081.     #SET(%CancelExists,'1')
  1082.   #ENDIF
  1083.   #SET(%FirstField,%Null)
  1084.   #FOR(%ScreenField)
  1085.     #IF(%ScreenFieldSkip <> 'Y' AND %FirstField= %Null)
  1086.       #SET(%FirstField,%ScreenField)
  1087.     #ENDIF
  1088.     #IF(%ScreenFieldSkip <> 'Y')
  1089.       #SET(%LastField,%ScreenField)
  1090.     #ENDIF
  1091.   #ENDFOR
  1092.   #IF(%FirstField = %Null AND %CancelExists = %NULL)
  1093.     #SET(%ErrorMessage,'Form21 Must Have Cancel Button If All Fields Are SKIP')
  1094.     #ERROR(%ErrorMessage)
  1095.   #ENDIF
  1096.   #SET(%TableForm,'1')
  1097.  
  1098.   #FOR(%Formula)
  1099.     #IF(UPPER(%FormulaClass) = 'SETUP')
  1100.   #INSERT(%GenerateFormula)
  1101.     #ENDIF
  1102.   #ENDFOR
  1103.   #IF(%SecondaryExist)                           #<!IF schema has a Secondary
  1104.   DO SecondaryLookups                            !Read any lookup fields
  1105.   #ENDIF
  1106.   #IF(%PullDownStructure)
  1107.   OPEN(%PullDown)
  1108.   SAV::PullDownOpened = True
  1109.   #EMBED('Setup Pulldown')                       #! Embedded Source Code
  1110.   #ENDIF
  1111.   OPEN(Screen)                                   !Open the FORM screen
  1112.   #EMBED('Setup Screen')
  1113.   DISPLAY                                        !Display screen fields
  1114.  
  1115.   LOOP                                           !Begin Main process loop
  1116.  
  1117.     #IF(%SecondaryExist)                         #<!IF File schema has Secondary
  1118.     #INSERT(%SecondaryChanged)
  1119.     #ENDIF
  1120.     #IF(%LoopFormulasExist = 'TRUE')             #<!Are there Formula fields?
  1121.      #SET(%GenerateFormulasOn,'TRUE')
  1122.     DO FormulaFields                             !Calculate Formula fields
  1123.     #ENDIF
  1124.     #EMBED('Computed Fields')
  1125.     DISPLAY
  1126.     SelectedField = SELECTED()
  1127.     IF FIELD() = %LastField AND SelectedField = %LastField
  1128.       SelectedField = NoMoreFields               !Enter On Last Field
  1129.     END
  1130.     CASE SelectedField
  1131.     #INSERT(%ScreenSetupRoutines)
  1132.       OF NoMoreFields                            !User pressed Enter or OK
  1133.         #EMBED('Before Next Procedure')
  1134.         %NextProcedure
  1135.         #EMBED('After Next Procedure')
  1136.         DO ProcedureReturn                       !Break from main Loop
  1137.     END                                          !End CASE Selected()
  1138.     ALERT(EscKey)
  1139.     #IF(%CancelExists = %Null)
  1140.     ALERT(CtrlEsc)
  1141.     #ENDIF
  1142.     #IF(%OKExists = %Null)
  1143.     ALERT(CtrlEnter)
  1144.     #ENDIF
  1145.     ACCEPT                                       !Enable screen entry
  1146.     #INSERT(%Form21KeyHandling)
  1147.     #IF(%CancelExists = %Null)
  1148.     IF KEYCODE() = CtrlEsc OR (KEYCODE() = EscKey AND FIELD() = %FirstField)
  1149.       DO ProcedureReturn                         #<!Break from main LOOP
  1150.     END
  1151.     #ENDIF
  1152.     CASE FIELD()                                 !Process fields
  1153.    #FOR(%ScreenField)
  1154.     #IF(%ScreenFieldUse = '?Ok')
  1155.      OF ?Ok                                      !On the OK button
  1156.         #EMBED('OK Button Press')
  1157.           #IF(%ScreenFieldEdit <> %NULL)
  1158.         %ScreenFieldEdit                         #<!Field Edit procedure
  1159.           #ENDIF
  1160.         SELECT(1)                                !Start with the first field
  1161.         SELECT                                   !and cycle non-stop
  1162.         CYCLE                                    !restart main process loop
  1163.  
  1164.     #ELSIF(%ScreenFieldUse = '?Cancel')
  1165.      OF ?Cancel                                  !On Cancel button
  1166.         #IF(%ScreenFieldEdit <> %NULL)
  1167.         %ScreenFieldEdit                         #<!Field edit procedure
  1168.         #ENDIF
  1169.         #IF(%Primary)
  1170.         GET(%Primary,0)                          #<!signal Browse to re-read
  1171.         #ENDIF
  1172.         DO ProcedureReturn                       !Break from main LOOP
  1173.  
  1174.     #ELSIF(%ScreenField = %LastField)
  1175.     OF %LastField
  1176.       #IF(%ScreenFieldEdit <> %NULL)
  1177.         %ScreenFieldEdit                         #<!Field edit procedure
  1178.       #ENDIF
  1179.       CYCLE                                      !restart main process loop
  1180.     #ELSE
  1181.     #INSERT(%ScreenEditRoutines)               #<! Completed %ScreenField
  1182.     #ENDIF
  1183.    #ENDFOR
  1184.     #INSERT(%PulldownEditRoutines)
  1185.     END                                          !End CASE FIELD
  1186.   END                                            !END MAIN PROCESS LOOP
  1187.  
  1188.   #FOR(%Formula)
  1189.     #IF(UPPER(%FormulaClass) = 'RETURN')
  1190.   #INSERT(%GenerateFormula)                      #<!Return Class formula
  1191.     #ENDIF
  1192.   #ENDFOR
  1193.  
  1194.   DO ProcedureReturn
  1195.  
  1196. !─────────────────────────────────────────────────────────────────────────────
  1197. ProcedureReturn ROUTINE
  1198.   #IF(%Pulldown)                                #! If a Pulldown exists
  1199.   IF SAV::PullDownOpened                        #<! IF the pulldown opened
  1200.     CLOSE(%Pulldown)                            #<! Close the Pulldown
  1201.   END                                           #<! END (IF the pulldown...)
  1202.   #ENDIF                                        #! END (IF a PullDown...)
  1203.   DO EndOfProcedureEmbed
  1204.   RETURN
  1205.  
  1206. !─────────────────────────────────────────────────────────────────────────────
  1207. EndOfProcedureEmbed ROUTINE
  1208. #EMBED('End of Procedure')
  1209. #EMBED('Custom Routines')
  1210.  
  1211. #INSERT(%InitFields)
  1212. #INSERT(%GenFormulas)
  1213. #IF(%SecondaryExist)
  1214. #INSERT(%SecondaryLookups)
  1215. #ENDIF
  1216. #!***************************************************************************
  1217. #!
  1218. #PROCEDURE(Menu21,'Version 2.1-Style Menu Procedure'),SCREEN,PULLDOWN
  1219. #!
  1220. #!┌──────────────────────────┤Procedure Template├──────────┬─────────────────┐
  1221. #!│                                Menu21                  │Version: 3007.105│
  1222. #!├──────────────────────────────┤Description├─────────────┴─────────────────┤
  1223. #!│ The Menu21 Template generates a Clarion Professional Developer 2.1 type  │
  1224. #!│ Menu procedure.                                                          │
  1225. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  1226. #!│Version   Comments                                                        │
  1227. #!│────────  ────────────────────────────────────────────────────────────────│
  1228. #!│3007.000  Release of CDD3 version 3007 templates                          │
  1229. #!│3007.105  Completed support for PullDowns                                 │
  1230. #!└──────────────────────────────────────────────────────────────────────────┘
  1231. #!
  1232. #PROTOTYPE('')
  1233. #INSERT(%StandardHeader)
  1234. %Procedure      PROCEDURE
  1235.  
  1236. LOC::FromField     BYTE
  1237. LOC::NextField     BYTE
  1238.  
  1239. %LocalData
  1240.  
  1241. %ScreenStructure
  1242. #IF(%PullDown)
  1243. %PulldownStructure
  1244. SAV::PullDownOpened BYTE(0)
  1245. #ENDIF
  1246. #EMBED('Data Section')
  1247.  
  1248.   CODE
  1249.  
  1250.   #EMBED('Setup Procedure')
  1251.   #SET(%FirstField,%Null)
  1252.   #FOR(%ScreenField)
  1253.     #IF(%ScreenFieldSkip <> 'Y' AND %FirstField= %Null)
  1254.       #SET(%FirstField,%ScreenField)
  1255.     #ENDIF
  1256.     #IF(%ScreenFieldSkip <> 'Y')
  1257.       #SET(%LastField,%ScreenField)
  1258.     #ENDIF
  1259.   #ENDFOR
  1260.   #SET(%TableForm,'1')
  1261.  
  1262.   #FOR(%Formula)
  1263.     #IF(UPPER(%FormulaClass) = 'SETUP')
  1264.   #INSERT(%GenerateFormula)
  1265.     #ENDIF
  1266.   #ENDFOR
  1267.   #IF(%SecondaryExist)                           #<!IF schema has a Secondary
  1268.   DO SecondaryLookups                            !Read any lookup fields
  1269.   #ENDIF
  1270.   #IF(%PullDownStructure)
  1271.   OPEN(%PullDown)
  1272.   SAV::PullDownOpened = True
  1273.   #EMBED('Setup Pulldown')                       #! Embedded Source Code
  1274.   #ENDIF
  1275.   OPEN(Screen)                                   !Open the FORM screen
  1276.   #EMBED('Setup Screen')
  1277.   DISPLAY                                        !Display screen fields
  1278.  
  1279.   LOOP                                           !Begin Main process loop
  1280.  
  1281.     #IF(%SecondaryExist)                         #!IF File schema has Secondary
  1282.     #INSERT(%SecondaryChanged)
  1283.     #ENDIF
  1284.     #IF(%LoopFormulasExist = 'TRUE')             #!Are there Formula fields?
  1285.      #SET(%GenerateFormulasOn,'TRUE')
  1286.     DO FormulaFields                             !Calculate Formula fields
  1287.     #ENDIF
  1288.     #EMBED('Computed Fields')
  1289.     DISPLAY
  1290.     CASE SELECTED()
  1291.     #INSERT(%ScreenSetupRoutines)
  1292.     END                                          !End CASE Selected()
  1293.     ALERT
  1294.     ALERT(EscKey)
  1295.     ALERT(CtrlEsc)
  1296.     ACCEPT                                       !Enable screen entry
  1297.     CASE KEYCODE()
  1298.       OF CtrlEsc                                 !User press CtrlEsc key
  1299.         Do ProcedureReturn
  1300.       OF EscKey                                  !User pressed Escape key
  1301.         IF SELECTED() = %FirstField              #<!If Escape On first field
  1302.           DO ProcedureReturn                     !  BREAK from main loop
  1303.         ELSIF FIELD() = 0                        !If Escape On Button
  1304.           LOC::FromField = SELECTED()            !Save Current Button Number
  1305.           Select(1)                              !Select First Field
  1306.           SELECT()                               !Select NonStop mode
  1307.           CYCLE                                  !Cycle to Accept
  1308.         ELSE
  1309.           SELECT(?-1)                            !Select Previous Field
  1310.           CYCLE                                  !Cycle to Accept
  1311.         END                                      !Field was not Cancel button
  1312.     #FOR(%HotKey)
  1313.       OF %HotKey                                 #<!User defined HotKey
  1314.         %HotKeyProc                              #<!HotKey Procedure
  1315.     #ENDFOR
  1316.     END                                          !End CASE Keycode
  1317.                                                  !If looking for prior field
  1318.     IF LOC::FromField                            !from button
  1319.         IF FIELD()                               !If entry field
  1320.           LOC::NextField = FIELD()               !Save as previous entry field
  1321.         END
  1322.         IF SELECTED() = LOC::FromField           !If next field is original button
  1323.           IF LOC::NextField                      !If found previous entry
  1324.              SELECT(LOC::NextField)              !Set to previous entry
  1325.              LOC::NextField = 0                  !Clear previous entry field number
  1326.              LOC::FromField = 0                  !Clear button field number
  1327.              CYCLE                               !Cycle to top of loop
  1328.           ELSE
  1329.              DO ProcedureReturn                  !No Previous entry, Exit
  1330.           END
  1331.         END                                      !looking for prior field
  1332.         CYCLE                                    !Cycle to top of loop
  1333.     END
  1334.     CASE FIELD()                                 !Process fields
  1335.    #FOR(%ScreenField)
  1336.    #INSERT(%ScreenEditRoutines)                #<! Completed %ScreenField
  1337.    #ENDFOR
  1338.     #INSERT(%PulldownEditRoutines)
  1339.     END                                          !End CASE FIELD
  1340.   END                                            !END MAIN PROCESS LOOP
  1341.   ALERT
  1342.  
  1343.   #FOR(%Formula)
  1344.     #IF(UPPER(%FormulaClass) = 'RETURN')
  1345.   #INSERT(%GenerateFormula)                      #<!Return Class formula
  1346.     #ENDIF
  1347.   #ENDFOR
  1348.   DO ProcedureReturn
  1349.  
  1350. !─────────────────────────────────────────────────────────────────────────────
  1351. ProcedureReturn ROUTINE
  1352.   #IF(%Pulldown)                                #! If a Pulldown exists
  1353.   IF SAV::PullDownOpened                        #<! IF the pulldown opened
  1354.     CLOSE(%Pulldown)                            #<! Close the Pulldown
  1355.   END                                           #<! END (IF the pulldown...)
  1356.   #ENDIF                                        #! END (IF a PullDown...)
  1357.   DO EndOfProcedureEmbed
  1358.   RETURN
  1359.  
  1360. !─────────────────────────────────────────────────────────────────────────────
  1361. EndOfProcedureEmbed ROUTINE
  1362. #EMBED('End of Procedure')
  1363. #EMBED('Custom Routines')
  1364.  
  1365.  
  1366. #INSERT(%InitFields)
  1367. #INSERT(%GenFormulas)
  1368. #IF(%SecondaryExist)
  1369. #INSERT(%SecondaryLookups)
  1370. #ENDIF
  1371. #!------------------------------------------------------------------------------
  1372. #!
  1373. #!                              Begin Repeat
  1374. #!
  1375. #!  Same as BeginBrowse to work with the Table21 template.
  1376. #!
  1377. #!------------------------------------------------------------------------------
  1378. #GROUP(%BeginRepeat)
  1379.   #IF(%Locator)                                #!Conditionally initialize
  1380.     #IF(%IncrementalLocator)
  1381.       #IF(%HotBar OR %First)                   #! the browse session manager
  1382. BeginRepeat(?Point,MaxRows,?%Locator,1,1)
  1383.       #ELSE
  1384. BeginRepeat(?Point,MaxRows,?%Locator,,1)
  1385.       #ENDIF
  1386.     #ELSE
  1387.       #IF(%HotBar OR %First)                   #! the browse session manager
  1388. BeginRepeat(?Point,MaxRows,?%Locator,1)
  1389.       #ELSE
  1390. BeginRepeat(?Point,MaxRows,?%Locator)
  1391.       #ENDIF
  1392.     #ENDIF
  1393.   #ELSE
  1394.     #IF(%HotBar OR %First)
  1395. BeginRepeat(?Point,MaxRows,,1) #<!Begin a browse session
  1396.     #ELSE
  1397. BeginRepeat(?Point,MaxRows)      #<!Begin a browse session
  1398.     #ENDIF
  1399.   #ENDIF
  1400. #!------------------------------------------------------------------------------
  1401. #!
  1402. #!                         Repeat Error Check
  1403. #!
  1404. #!------------------------------------------------------------------------------
  1405. #GROUP(%RepeatErrorCheck)
  1406. #!
  1407. #IF(%Primary = %Null)
  1408.   #SET(%ErrorMessage, (%Procedure & ' ERROR: No file has been chosen for this procedure.'))
  1409.   #ERROR(%ErrorMessage)
  1410.   #SET(%ErrorMessage, ' A file must be selected for this procedure.')
  1411.   #ERROR(%ErrorMessage)
  1412. #ENDIF
  1413. #IF(%PrimaryKey = %Null)
  1414.   #SET(%ErrorMessage, (%Procedure & ' ERROR: No Access Key has been chosen for this procedure.'))
  1415.   #ERROR(%ErrorMessage)
  1416.   #SET(%ErrorMessage, ' An Access Key must be identified on the File Schematic.')
  1417.   #ERROR(%ErrorMessage)
  1418. #ENDIF
  1419. #IF(%KeyRangeField)
  1420.   #IF(%KeyNoCase)                         #!  Key is not case sensitive
  1421.     #IF(UPPER(%KeyRangeField) = UPPER(%RangeValue))
  1422.       #SET(%ErrorMessage, (%Procedure & ' ERROR: Range Limit Field and Range Value fields must'))
  1423.       #ERROR(%ErrorMessage)
  1424.       #SET(%ErrorMessage, ' be separate fields.')
  1425.       #ERROR(%ErrorMessage)
  1426.     #ENDIF
  1427.   #ELSE
  1428.     #IF(%KeyRangeField = %RangeValue)
  1429.       #SET(%ErrorMessage, (%Procedure & ' ERROR: Range Limit Field and Range Value fields must'))
  1430.       #ERROR(%ErrorMessage)
  1431.       #SET(%ErrorMessage, ' be separate fields.')
  1432.       #ERROR(%ErrorMessage)
  1433.     #ENDIF
  1434.   #ENDIF
  1435. #ENDIF
  1436. #IF(%First)
  1437.   #SET(%FirstHotEquate, ('?' & %First))
  1438.   #FIX(%ScreenField,%FirstHotEquate)
  1439.   #IF(%ScreenField <> %FirstHotEquate)
  1440.     #SET(%ErrorMessage, (%Procedure & ' ERROR: the First Hot field must be a display'))
  1441.     #ERROR(%ErrorMessage)
  1442.     #SET(%ErrorMessage, ' field on the SCREEN. ')
  1443.     #ERROR(%ErrorMessage)
  1444.   #ENDIF
  1445. #ENDIF
  1446. #IF(%Last)
  1447.   #SET(%LastHotEquate, ('?' & %Last))
  1448.   #FIX(%ScreenField,%LastHotEquate)
  1449.   #IF(%ScreenField <> %LastHotEquate)
  1450.     #SET(%ErrorMessage, (%Procedure & ' ERROR: the Last Hot field must be a display'))
  1451.     #ERROR(%ErrorMessage)
  1452.     #SET(%ErrorMessage, ' field on the SCREEN. ')
  1453.     #ERROR(%ErrorMessage)
  1454.   #ENDIF
  1455. #ENDIF
  1456. #FIX(%File,%Primary)
  1457. #IF(%DisplayKey)
  1458.   #FIX(%Key,%DisplayKey)
  1459. #ELSE
  1460.   #FIX(%Key,%PrimaryKey)
  1461. #ENDIF
  1462. #FIX(%Key,%PrimaryKey)
  1463. #IF(%KeyRangeField)
  1464.   #SET(%FieldFound,%Null)
  1465.   #FOR(%KeyField)
  1466.     #IF(%KeyNoCase)
  1467.       #IF(UPPER(%KeyField) = UPPER(%KeyRangeField))
  1468.         #SET(%FieldFound,'Yes')
  1469.         #BREAK
  1470.       #ENDIF
  1471.     #ELSE
  1472.       #IF(%KeyField = %KeyRangeField)
  1473.         #SET(%FieldFound,'Yes')
  1474.         #BREAK
  1475.       #ENDIF
  1476.     #ENDIF
  1477.   #ENDFOR
  1478.   #IF(%FieldFound = %Null)
  1479.     #SET(%ErrorMessage, (%Procedure & ' ERROR: Key Range Limit Field must be a component of the'))
  1480.     #ERROR(%ErrorMessage)
  1481.     #SET(%ErrorMessage, ' File Access Key')
  1482.     #ERROR(%ErrorMessage)
  1483.   #ENDIF
  1484. #ENDIF
  1485. #!***************************************************************************
  1486. #GROUP(%Form21KeyHandling)
  1487. #!
  1488. #!┌────────────────────────────┤Template Group├────────────┬─────────────────┐
  1489. #!│                            Form21KeyHandling           │Version: 3007.105│
  1490. #!├──────────────────────────────┤Description├─────────────┴─────────────────┤
  1491. #!│Purpose:      Handle Form21 (and MemForm21) CASE KEYCODE() generation     │
  1492. #!│Called From:  Form21 PROCEDURE                                            │
  1493. #!│              MEMForm21 PROCEDURE                                         │
  1494. #!│Assumptions:  None                                                        │
  1495. #!│Inserts:      None                                                        │
  1496. #!│Symbols Set:  None                                                        │
  1497. #!│Notes:        None                                                        │
  1498. #!├───────────────────────────────┤Comments├─────────────────────────────────┤
  1499. #!│Version   Comments                                                        │
  1500. #!│────────  ────────────────────────────────────────────────────────────────│
  1501. #!│3007.000  Release of CDD3 version 3007 templates                          │
  1502. #!│3007.105  Added to CPD21.TPX                                              │
  1503. #!└──────────────────────────────────────────────────────────────────────────┘
  1504. #!
  1505. CASE KEYCODE()
  1506. OF CtrlEsc                                       #<! User Wants Out
  1507. #FOR(%HotKey)
  1508.   #IF(UPPER(%HotKey) = 'CTRLESC')
  1509.   %HotKeyProc                                    #<! HotKey Procedure
  1510.     #BREAK
  1511.   #ENDIF
  1512. #ENDFOR
  1513. #IF(%CancelExists)
  1514.   IF FIELD() <> ?Cancel                          #<! If user pressed Escape
  1515.     SELECT(?Cancel)                              #<! Select Cancel button
  1516.     PRESS(EnterKey)                              #<! Process Cancel button code
  1517.     CYCLE                                        #<! Cycle to Accept
  1518.   END                                            #<! Field was not Cancel button
  1519. #ENDIF
  1520. OF CtrlEnter                                     #<! User Wants to Save Screen
  1521. #FOR(%HotKey)
  1522.   #IF(UPPER(%HotKey) = 'CTRLENTER')
  1523.   %HotKeyProc                                    #<! HotKey Procedure
  1524.     #BREAK
  1525.   #ENDIF
  1526. #ENDFOR
  1527.   SELECT(1)                                      #<! Start with the first field
  1528.   SELECT                                         #<! and cycle non-stop
  1529.   CYCLE                                          #<! restart main process loop
  1530. OF EscKey                                        #<! User pressed Escape key
  1531. #IF(%CancelExists)
  1532.   IF FIELD() = %FirstField                       #<! If Escape On first field
  1533.     SELECT(?Cancel)                              #<! Select Cancel button
  1534.     PRESS(EnterKey)                              #<! Process Cancel button code
  1535.     CYCLE                                        #<! Cycle to Accept
  1536. #ELSE
  1537.   IF FIELD() = %FirstField                       #<! If Escape On first field
  1538.     SETKEYCODE(CtrlEsc)                          #<! Select Cancel button
  1539. #ENDIF
  1540.   ELSIF FIELD() > 0
  1541.     SELECT(?-1)                                  #<! Select Previous Field
  1542.     CYCLE                                        #<! Cycle to Accept
  1543.   END                                            #<! Field was not Cancel button
  1544. #IF(%HotKeysExist)
  1545.   #FOR(%HotKey)
  1546. OF %HotKey                                       #<! User defined HotKey
  1547.   %HotKeyProc                                    #<! HotKey Procedure
  1548.   #ENDFOR
  1549. #ENDIF
  1550. END                                              #<! End CASE Keycode
  1551. #!***************************************************************************
  1552.